#lang racket


(require mysterx)

(require "../base/main.rkt")
(require "../backends/main.rkt")

(provide load-autocad-com
         
         ; constants
         ac-active-viewport
         ac-all-viewports
         
         ac-intersection
         ac-subtraction
         ac-union
         
         sky-status-off
         sky-status-background
         sky-status-background-and-illumination
         
         optional
         
         ; methods
         add-3d-face
         add-3d-poly
         add-arc
         add-box
         add-circle
         add-cone
         add-cylinder
         add-document-layers
         add-document-layers
         add-ellipse
         add-extruded-solid
         add-line
         add-point
         add-polyline
         add-sphere
         add-spline
         add-region
         boolean
         close
         delete
         end-undo-mark
         get-bounding-box
         item
         item-document-layers
         move
         offset
         open
         regen
         rotate3d
         start-undo-mark
         transform-by
         
         ; variables
         get-active-document-variable
         set-active-document-variable
         
         get-loft-param-variable
         set-loft-param-variable
         
         get-perspective-variable
         set-perspective-variable
         
         get-sky-status-variable
         set-sky-status-variable
         
         ; 3d-face properties
         3d-face?
         
         ; 3d-polyline properties
         3d-polyline?
         
         ; 3d-solid properties
         3d-solid?
         
         ; active document properties
         get-active-document-modelspace
         
         ; autocad properties
         get-autocad-active-document
         get-autocad-application
         get-autocad-documents
         
         ; arc properties
         arc?
         get-arc-center
         get-arc-radius
         get-arc-start-angle
         get-arc-end-angle
         
         ; circle properties
         circle?
         get-circle-center
         get-circle-radius
         get-circle-normal
         
         ; document properties
         get-document-layers
         
         get-document-active-layer
         set-document-active-layer
         
         ; line properties
         line?
         
         ; modelspace properties
         get-modelspace-count
         
         ; object properties
         get-object-center
         get-object-closed
         set-object-closed
         get-object-handle
         get-object-name
         get-object-position
         get-object-radius
         
         ; polyline properties
         polyline?
         
         ; region properties
         region?
         
         ; spline properties
         spline?
         
         ; commands
         vbCr
         send-command)


(define autocad-com-msg "Waiting for AutoCAD to be ready...")


(define (autocad-invoke . args)
  (try-exn-connection
   autocad-com-msg
   (λ () (apply com-invoke args))))

(define (autocad-get-property . args)
  (try-exn-connection
   autocad-com-msg
   (λ () (apply com-get-property args))))

(define (autocad-set-property! . args)
  (try-exn-connection
   autocad-com-msg
   (λ () (apply com-set-property! args))))


(define autocad-class #f)
(define autocad-active-document #f)
(define autocad-modelspace #f)


(define (load-autocad-com)
  (set! autocad-class (let ((coclass-name "AutoCAD Application"))
                        (with-handlers ((exn?
                                         (λ (e)
                                           (displayln "Starting AutoCAD...")
                                           (cci/coclass coclass-name))))
                          (gao/coclass coclass-name)))))


; constants

(define ac-active-viewport 0)
(define ac-all-viewports 1)
(define ac-intersection 1)
(define ac-subtraction 2)
(define ac-union 0)

(define optional com-omit)

(define sky-status-off 0)
(define sky-status-background 1)
(define sky-status-background-and-illumination 2)


; methods

; info: the last coord must be repeated to define 3-coord faces
(define add-3d-face
  (case-lambda
    ((point1 point2 point3)
     (autocad-invoke (get-active-document-modelspace) "Add3DFace" point1 point2 point3 point3))
    ((point1 point2 point3 point4)
     (autocad-invoke (get-active-document-modelspace) "Add3DFace" point1 point2 point3 point4))))

(define (add-3d-poly points)
  (autocad-invoke (get-active-document-modelspace) "Add3Dpoly" points))

(define (add-arc center radius start-angle end-angle)
  (autocad-invoke (get-active-document-modelspace) "AddArc" center radius start-angle end-angle))

(define (add-box origin length width height)
  (autocad-invoke (get-active-document-modelspace) "AddBox" origin length width height))

(define (add-circle center radius)
  (autocad-invoke (get-active-document-modelspace) "AddCircle" center radius))

(define (add-cone center base-radius height)
  (autocad-invoke (get-active-document-modelspace) "AddCone" center base-radius height))

(define (add-cylinder center radius height)
  (autocad-invoke (get-active-document-modelspace) "AddCylinder" center radius height))

(define (add-document-layers layer-name)
  (autocad-invoke (get-document-layers) "Add" layer-name))

(define (add-ellipse center major-axis radius-ratio)
  (autocad-invoke (get-active-document-modelspace) "AddEllipse" center major-axis radius-ratio))

(define (add-extruded-solid profile height taper-angle)
  (autocad-invoke (get-active-document-modelspace) "AddExtrudedSolid" profile height taper-angle))

(define (add-line start-point end-point)
  (autocad-invoke (get-active-document-modelspace) "AddLine" start-point end-point))

(define (add-point point)
  (autocad-invoke (get-active-document-modelspace) "AddPoint" point))

(define (add-polyline vertices)
  (autocad-invoke (get-active-document-modelspace) "AddPolyline" vertices))

(define (add-sphere center radius)
  (autocad-invoke (get-active-document-modelspace) "AddSphere" center radius))

(define (add-spline points start-tangent end-tangent)
  (autocad-invoke (get-active-document-modelspace) "AddSpline" points start-tangent end-tangent))

(define (add-region shapes)
  (autocad-invoke (get-active-document-modelspace) "AddRegion" shapes))

(define (boolean operation shape1 shape2)
  (autocad-invoke shape1 "Boolean" operation shape2)
  shape1)

(define (close save-changes?)
  (autocad-invoke (get-autocad-active-document) "Close" save-changes?)
  (set! autocad-active-document #f)
  (set! autocad-modelspace #f))

(define (delete object)
  (autocad-invoke object "Delete"))

(define (end-undo-mark)
  (autocad-invoke (get-autocad-active-document) "EndUndoMark"))

; edit: test with 'let' instead of 'define'
(define (get-bounding-box object)
  (define min-point (box (vector 0.0 0.0 0.0)))
  (define max-point (box (vector 0.0 0.0 0.0)))
  (autocad-invoke object "GetBoundingBox" min-point max-point)
  (list (unbox min-point) (unbox max-point)))

(define (item i)
  (autocad-invoke (get-active-document-modelspace) "Item" i))

(define (item-document-layers name)
  (with-handlers ((exn? (λ (e) #f)))
    (autocad-invoke (get-document-layers) "Item" name)))

(define (move shape point1 point2)
  (autocad-invoke shape "Move" point1 point2)
  shape)

(define (offset object distance)
  (autocad-invoke object "Offset" distance))

(define (open name)
  (begin0
    (autocad-invoke (get-autocad-documents) "Open" name)
    (set! autocad-active-document #f)
    (set! autocad-modelspace #f)))

(define (regen viewport)
  (autocad-invoke (get-autocad-active-document) "Regen" viewport))

(define (rotate3d shape point1 point2 rotation-angle)
  (autocad-invoke
   shape
   "Rotate3D"
   point1
   point2
   rotation-angle)
  shape)

(define (start-undo-mark)
  (autocad-invoke (get-autocad-active-document) "StartUndoMark"))

(define (transform-by shape matrix)
  (autocad-invoke shape "TransformBy" matrix)
  shape)


; variables

(define (get-active-document-variable name)
  (autocad-invoke (get-autocad-active-document) "GetVariable" name))

(define (set-active-document-variable name value)
  (autocad-invoke (get-autocad-active-document) "SetVariable" name value))


;; loft normals

(define loft-normals-name "LOFTNORMALS")

(define (loft-normals-type s)
  (case s
    ('ruled 0)
    ('smooth-fit 1)
    ('start-cross-section 2)
    ('end-cross-section 3)
    ('start-and-end-cross-section 4)
    ('all-cross-sections 5)
    ('use-draft-angle-and-magniture 6)
    (else (error 'loft-normals-type "Unhandled loft normals type"))))

(define (loft-normals-type-rev s)
  (case s
    ((0) 'ruled)
    ((1) 'smooth-fit)
    ((2) 'start-cross-section)
    ((3) 'end-cross-section)
    ((4) 'start-and-end-cross-section)
    ((5) 'all-cross-sections)
    ((6) 'use-draft-angle-and-magniture)
    (else (error 'loft-normals-type-rev "Unhandled loft normals type"))))

(define (get-loft-normals-variable)
  (loft-normals-type-rev (get-active-document-variable loft-normals-name)))

(define (set-loft-normals-variable value)
  (set-active-document-variable loft-normals-name (loft-normals-type value)))


; loft ang1

(define loft-ang1-name "LOFTANG1")

(define (get-loft-ang1-variable)
  (get-active-document-variable loft-ang1-name))

(define (set-loft-ang1-variable value)
  (set-active-document-variable loft-ang1-name value))


; loft ang2

(define loft-ang2-name "LOFTANG2")

(define (get-loft-ang2-variable)
  (get-active-document-variable loft-ang2-name))

(define (set-loft-ang2-variable value)
  (set-active-document-variable loft-ang2-name value))


; loft mag1

(define loft-mag1-name "LOFTMAG1")

(define (get-loft-mag1-variable)
  (get-active-document-variable loft-mag1-name))

(define (set-loft-mag1-variable value)
  (set-active-document-variable loft-mag1-name value))


; loft mag2

(define loft-mag2-name "LOFTMAG2")

(define (get-loft-mag2-variable)
  (get-active-document-variable loft-mag2-name))

(define (set-loft-mag2-variable value)
  (set-active-document-variable loft-mag2-name value))


; loft param

(define loft-param-name "LOFTPARAM")

(define (loft-param-type s)
  (case s
    ('no-twist 1)
    ('align-direction 2)
    ('simplify 4)
    ('close 8)
    (else (error 'loft-param-type "Unhandled loft param type"))))

(define (loft-param-type-rev s)
  (case s
    ((1) '(no-twist))
    ((2) '(align-direction))
    ((3) '(no-twist align-direction))
    ((4) '(simplify))
    ((5) '(no-twist simplify))
    ((6) '(align-direction simplify))
    ((7) '(no-twist align-direction simplify))
    ((8) '(close))
    ((9) '(no-twist close))
    ((10) '(align-direction close))
    ((11) '(no-twist align-direction close))
    ((12) '(simplify close))
    ((13) '(no-twist simplify close))
    ((14) '(align-direction simplify close))
    ((15) '(no-twist align-direction simplify close))
    (else (error 'loft-param-type-rev "Unhandled loft param type"))))

(define (get-loft-param-variable)
  (loft-param-type-rev (get-active-document-variable loft-param-name)))

(define (set-loft-param-variable value)
  (set-active-document-variable loft-param-name (reduce + (map loft-param-type value))))


(define perspective-name "PERSPECTIVE")

(define (get-perspective-variable)
  (get-active-document-variable perspective-name))

(define (set-perspective-variable value)
  (set-active-document-variable perspective-name value))


(define sky-status-name "SKYSTATUS")

(define (get-sky-status-variable)
  (get-active-document-variable sky-status-name))

(define (set-sky-status-variable value)
  (set-active-document-variable sky-status-name value))


; 3d-face properties

(define 3d-face-name "AcDbFace")

(define (3d-face? object)
  (string=? (get-object-name object) 3d-face-name))


; 3d-polyline properties

(define 3d-polyline-name "AcDb3dPolyline")

(define (3d-polyline? object)
  (string=? (get-object-name object) 3d-polyline-name))


; 3d-solid properties

(define 3d-solid-name "AcDb3dSolid")

(define (3d-solid? object)
  (string=? (get-object-name object) 3d-solid-name))


; active document properties

(define (get-active-document-modelspace)
  (if autocad-modelspace
      autocad-modelspace
      (let ((modelspace (autocad-get-property autocad-class "ActiveDocument" "ModelSpace")))
        (set! autocad-modelspace modelspace)
        modelspace)))


; autocad properties

(define (get-autocad-active-document)
  (if autocad-active-document
      autocad-active-document
      (let ((active-document (autocad-get-property autocad-class "ActiveDocument")))
        (set! autocad-active-document active-document)
        active-document)))

(define (get-autocad-application)
  (autocad-get-property autocad-class "Application"))

(define (get-autocad-documents)
  (autocad-get-property autocad-class "Documents"))


; arc properties

(define arc-name "AcDbArc")

(define (arc? object)
  (string=? (get-object-name object) arc-name))

(define (get-arc-center object)
  (get-object-center object))

(define (get-arc-radius object)
  (get-object-radius object))

(define (get-arc-start-angle object)
  (com-get-property object "StartAngle"))

(define (get-arc-end-angle object)
  (com-get-property object "EndAngle"))


; circle properties

(define circle-name "AcDbCircle")

(define (circle? object)
  (string=? (get-object-name object) circle-name))

(define (get-circle-center object)
  (get-object-center object))

(define (get-circle-radius object)
  (get-object-radius object))

(define (get-circle-normal object)
  (autocad-get-property object "Normal"))


; document properties

(define (get-document-property name)
  (autocad-get-property (get-autocad-active-document) name))

(define (set-document-property name val)
  (autocad-set-property! (get-autocad-active-document) name val))


(define (get-document-layers)
  (get-document-property "Layers"))

(define (get-document-views)
  (get-document-property "Views"))


(define (get-document-active-layer)
  (get-document-property "ActiveLayer"))

(define (set-document-active-layer layer)
  (set-document-property "ActiveLayer" layer))


; line properties

(define line-name "AcDbLine")

(define (line? object)
  (string=? (get-object-name object) line-name))


; document properties

(define (get-modelspace-count)
  (autocad-get-property (get-active-document-modelspace) "Count"))


; object properties

(define (get-object-center object)
  (autocad-get-property object "Center"))

(define (get-object-closed object)
  (autocad-get-property object "Closed"))

(define (set-object-closed object closed?)
  (autocad-set-property! object "Closed" closed?))

(define (get-object-handle object)
  (autocad-get-property object "Handle"))

(define (get-object-name object)
  (autocad-get-property object "ObjectName"))

(define (get-object-position object)
  (autocad-get-property object "Position"))

(define (get-object-radius object)
  (com-get-property object "Radius"))


; polyline properties

(define polyline-name "AcDb2dPolyline")

(define (polyline? object)
  (string=? (get-object-name object) polyline-name))


; region

(define region-name "AcDbRegion")

(define (region? object)
  (string=? (get-object-name object) region-name))


; spline propeties

(define spline-name "AcDbSpline")

(define (spline? object)
  (string=? (get-object-name object) spline-name))


; commands

(define vbCr
  (string-append
   (string #\return)
   (string #\newline)))

(define (send-command command)
  (autocad-invoke
   (get-autocad-active-document)
   "SendCommand"
   command))